home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / dviware / dvitovdu32 / src / pascal / vis240vdu.p < prev    next >
Text File  |  1991-11-10  |  10KB  |  311 lines

  1. (* VDU routines for a VIS240 terminal. *)
  2.  
  3. #include 'globals.h';
  4. #include 'screenio.h';
  5. #include 'vdu.h';
  6.  
  7. VAR
  8.    charht : INTEGER;   (* set in LoadFont and used in ShowChar *)
  9.    lastv  : INTEGER;   (* ShowChar remembers last vertical coordinate *)
  10.  
  11. (******************************************************************************)
  12.  
  13. PROCEDURE StartText;
  14.  
  15. (* We are about to draw text in dialogue region. *)
  16.  
  17. BEGIN
  18. WriteChar(ESC);
  19. WriteChar(CHR(134b));   (* leave graphics mode *)
  20. END; (* StartText *)
  21.  
  22. (******************************************************************************)
  23.  
  24. PROCEDURE MoveAbs (row, col : INTEGER);
  25.  
  26. (* Move cursor to given screen position. *)
  27.  
  28. BEGIN
  29. WriteChar(ESC); WriteChar('[');
  30. WriteInt(row);
  31. WriteChar(';');
  32. WriteInt(col);
  33. WriteChar('H');
  34. END; (* MoveAbs *)
  35.  
  36. (******************************************************************************)
  37.  
  38. PROCEDURE MoveToTextLine (line : INTEGER);
  39.  
  40. (* Move current position to start of given line. *)
  41.  
  42. BEGIN
  43. MoveAbs(line,1);
  44. END; (* MoveToTextLine *)
  45.  
  46. (******************************************************************************)
  47.  
  48. PROCEDURE ClearTextLine (line : INTEGER);
  49.  
  50. (* Erase given line; note that DVItoVDU does not assume anything about the
  51.    current position at the end of this routine.
  52. *)
  53.  
  54. BEGIN
  55. MoveAbs(line,1);
  56. WriteChar(ESC);
  57. WriteString('[K');   (* erase to end of line *)
  58. END; (* ClearTextLine *)
  59.  
  60. (******************************************************************************)
  61.  
  62. PROCEDURE StartGraphics;
  63.  
  64. (* We are about to draw in window region. *)
  65.  
  66. BEGIN
  67. WriteChar(ESC);
  68. WriteString('Pp');   (* enter graphics mode *)
  69. lastv := 999999;     (* undefined value for next ShowChar call *)
  70. END; (* StartGraphics *)
  71.  
  72. (******************************************************************************)
  73.  
  74. PROCEDURE ClearScreen;
  75.  
  76. BEGIN
  77. WriteChar(ESC);
  78. WriteString('[2J');   (* erase entire screen *)
  79. (* note that VT125 has a separate graphics plane which we need to erase *)
  80. StartGraphics;        (* switch to REGIS mode *)
  81. WriteString('S(E)');  (* erase graphics plane *)
  82. StartText;            (* exit in text mode *)
  83. END; (* ClearScreen *)
  84.  
  85. (******************************************************************************)
  86.  
  87. PROCEDURE LoadFont (fontname : string;
  88.                     fontsize : INTEGER;
  89.                     mag, hscale, vscale : REAL);
  90.  
  91. (* Use the given information to select an appropriate character size
  92.    (based on horizontal AND vertical scaling) for future calls of ShowChar.
  93. *)
  94.  
  95. VAR wd, ht : INTEGER;   (* we will send T ( Swd Hht ) *)
  96.  
  97. BEGIN
  98. WriteChar('T');
  99. WriteChar('(');
  100. (* scale fontsize horizontally and choose an appropriate text width *)
  101. wd := TRUNC( (fontsize * mag * hscale) + 0.5 ) DIV 9;
  102. IF wd > 16 THEN wd := 16;             (* wd now in 0,1,2,...,16 *)
  103. (* larger widths tend to be too big so adjust accordingly (trial and error) *)
  104. IF wd > 1  THEN wd := wd DIV 2;
  105. WriteChar('S');
  106. WriteInt(wd);
  107. (* scale fontsize vertically and choose an appropriate text height *)
  108. ht := TRUNC( (fontsize * mag * vscale) + 0.5 ) DIV 10;
  109. IF      ht < 1  THEN ht := 1          (* ht must not be 0 *)
  110. ELSE IF ht > 16 THEN ht := 16;        (* ht now in 1,2,...,16 *)
  111. charht := ht * 10;                    (* charht now in 10,20,30,...,160 *)
  112. (* restrict charht to <= windowv so screenv-charht in ShowChar will be >= 0 *)
  113. IF charht > windowv THEN BEGIN
  114.    charht := windowv;
  115.    ht     := windowv DIV 10;
  116. END;
  117. (* now reduce charht by one fifth to allow for descenders in ShowChar *)
  118. charht := ((charht * 4) DIV 5) - 1;   (* exact if charht is multiple of 10 *)
  119. WriteChar('H');
  120. WriteInt(ht);
  121. (* Note that VT125 and GIGI VDUs sometimes vary the vertical thickness of text
  122.    (only for odd ht values???).  VT240 does not; instead, charht is sometimes
  123.    1 pixel too much and baseline won't agree with Box/Full characters!
  124. *)
  125. WriteChar(')');
  126. END; (* LoadFont *)
  127.  
  128. (******************************************************************************)
  129.  
  130. PROCEDURE ShowChar (screenh, screenv : INTEGER;
  131.                     ch : CHAR);
  132.  
  133. (* Show the given Terse character (mapped to ASCII) using the given position.
  134.    We remember the vertical position in lastv so we can reduce the output
  135.    bytes needed to position the next Terse character on the same line.
  136.    StartGraphics resets lastv to an undefined state (= 999999).
  137. *)
  138.  
  139. VAR newch : CHAR;   (* = TeXtoASCII[ch] *)
  140.  
  141. BEGIN
  142. WriteChar('P'); WriteChar('[');
  143. WriteInt(screenh);
  144. (* charht allows for descenders and is used to shift ref pt of REGIS ch
  145.    (top left pixel) so that REGIS and TeX baselines will match.
  146.    LoadFont guarantees that screenv - charht >= 0.
  147. *)
  148. screenv := screenv - charht;
  149. IF lastv <> screenv THEN BEGIN     (* we need to send new vertical coordinate *)
  150.    WriteChar(',');
  151.    WriteInt(screenv);
  152.    lastv := screenv;               (* remember for next ShowChar call *)
  153. END;
  154. WriteChar(']');
  155. WriteChar('T');
  156. newch := TeXtoASCII[ch];           (* convert TeX ch to ASCII *)
  157. IF newch <> '''' THEN BEGIN
  158.    WriteChar('''');   (* open quoted string *)
  159.    IF newch <> '?' THEN
  160.       (* newch is similar to TeX ch *)
  161.       WriteChar(newch)
  162.    ELSE
  163.       (* attempt to display something other than ? *)
  164.       CASE ORD(ch) OF
  165.       13b..17b :   (* ff, fi, fl, ffi, ffl *)
  166.           BEGIN
  167.           WriteChar('f');
  168.           (* REGIS doesn't care if no room at right edge *)
  169.           CASE ORD(ch) OF
  170.           13b : WriteChar('f') ;
  171.           14b : WriteChar('i') ;
  172.           15b : WriteChar('l') ;
  173.           16b,
  174.           17b : BEGIN
  175.                 WriteChar('f');
  176.                 IF ch = CHR(16b) THEN
  177.                    WriteChar('i')
  178.                 ELSE
  179.                    WriteChar('l');
  180.                 END;
  181.           END;
  182.           END;
  183.       31b : WriteChar('B');   (* German sharp S *)
  184.       32b, 33b, 35b, 36b :    (* diphthongs: ae, oe, AE, OE *)
  185.           BEGIN
  186.           CASE ORD(ch) OF
  187.           32b : WriteChar('a') ;
  188.           33b : WriteChar('o') ;
  189.           35b : WriteChar('A') ;
  190.           36b : WriteChar('O')
  191.           END;
  192.           CASE ORD(ch) OF
  193.           32b, 33b : WriteChar('e') ;
  194.           35b, 36b : WriteChar('E')
  195.           END;
  196.           END;
  197.       40b : WriteChar('/');   (* Polish suppressed l and L *)
  198.       OTHERWISE
  199.           WriteChar('?');
  200.       END;
  201.    WriteChar('''');   (* close quoted string *)
  202. END
  203. ELSE BEGIN
  204.    WriteChar('"'); WriteChar(''''); WriteChar('"');     (* send "'" *)
  205. END;
  206. END; (* ShowChar *)
  207.  
  208. (******************************************************************************)
  209.  
  210. PROCEDURE ShowRectangle (screenh, screenv,          (* top left pixel *)
  211.                          width, height : INTEGER;   (* size of rectangle *)
  212.                          ch : CHAR);                (* black pixel *)
  213.  
  214. (* Display the given rectangle (without using the given black pixel character).
  215.    DVItoVDU ensures the top left position is visible and the given
  216.    dimensions do not go beyond the window edges.
  217. *)
  218.  
  219. BEGIN
  220. IF height = 1 THEN BEGIN                    (* show row vector *)
  221.    WriteChar('P'); WriteChar('[');          (* move cursor to start of row *)
  222.    WriteInt(screenh); WriteChar(',');
  223.    WriteInt(screenv);
  224.    (* call @R macrograph to draw starting pixel and begin row *)
  225.    WriteChar('@'); WriteChar('R');
  226.    WriteInt(width-1); WriteChar(']');
  227. END
  228. ELSE IF width = 1 THEN BEGIN                (* show column vector *)
  229.    WriteChar('P'); WriteChar('[');          (* move cursor to start of column *)
  230.    WriteInt(screenh); WriteChar(',');
  231.    WriteInt(screenv);
  232.    (* call @C macrograph to draw starting pixel and begin column *)
  233.    WriteChar('@'); WriteChar('C');
  234.    WriteInt(height-1); WriteChar(']');
  235. END
  236. ELSE BEGIN
  237.    (* assume height and width > 1 and use shading to fill rectangle *)
  238.    WriteChar('P'); WriteChar('['); WriteChar(',');   (* position to last row *)
  239.    WriteInt(screenv+height-1);
  240.    (* call @E macrograph to define shading reference line and start
  241.       position command that moves to start of first row *)
  242.    WriteChar('@'); WriteChar('E');
  243.    WriteInt(screenh); WriteChar(',');
  244.    WriteInt(screenv);
  245.    (* call @R macrograph to draw starting pixel and begin rectangle *)
  246.    WriteChar('@'); WriteChar('R');
  247.    WriteInt(width-1);
  248.    (* call @D macrograph to disable shading *)
  249.    WriteChar('@'); WriteChar('D');
  250. END;
  251. END; (* ShowRectangle *)
  252.  
  253. (******************************************************************************)
  254.  
  255. PROCEDURE ResetVDU;
  256.  
  257. (* We don't do a hardware reset, but leave VDU gracefully. *)
  258.  
  259. BEGIN
  260. StartGraphics;             (* for following REGIS commands *)
  261. WriteString('@.');         (* clear macrograph storage *)
  262. WriteString('T(E)');       (* restore Text attributes saved in InitVDU *)
  263. StartText;                 (* safer to leave in text mode *)
  264. END; (* ResetVDU *)
  265.  
  266. (******************************************************************************)
  267.  
  268. PROCEDURE InitVDU;
  269.  
  270. (* The dialogue region is the top 4 lines.
  271.    The window region is the remaining area of the screen.
  272. *)
  273.  
  274. BEGIN
  275. DVIstatusl    := 1;
  276. windowstatusl := 2;
  277. messagel      := 3;
  278. commandl      := 4;
  279. bottoml       := 24;
  280. (* DVItoVDU's coordinate scheme is the same as the REGIS scheme. *)
  281. windowh  := 0;
  282. windowv  := 80;      (* = height of 4 dialogue lines (better for LoadFont if
  283.                           windowv is a multiple of 10) *)
  284. windowwd := 768;
  285. windowht := 480 - windowv;
  286.  
  287. (* the VIS240/241 has more text lines and a bigger window region: *)
  288. bottoml  := 29;
  289. windowwd := 800;
  290. windowht := 580 - windowv;
  291.  
  292. StartGraphics;                 (* for following REGIS commands *)
  293.  
  294. (* Set Text and Writing attributes to known initial states. *)
  295. (* save current Text attributes; will be restored by ResetVDU *)
  296. WriteString('T(B)');
  297. (* default character set, no italic slant, direction right, default text size *)
  298. WriteString('T(A0,I0,D0,S1)');
  299. (* solid fill, no alternate, normal, shading disabled, overlay *)
  300. WriteString('W(P1,A0,N0,S0,V)');
  301.  
  302. (* Define some macrographs for frequently used strings in ShowRectangle. *)
  303. WriteString('@.');             (* clear macrograph storage *)
  304. WriteString('@:E]W(S1)P[@;');  (* @E = enable shading for filled rectangle *)
  305. WriteString('@:D]W(S0)@;');    (* @D = disable shading *)
  306. WriteString('@:R]V[]V[+@;');   (* @R = mid part of drawing a row vector *)
  307. WriteString('@:C]V[]V[,+@;');  (* @C = mid part of drawing a column vector *)
  308.  
  309. StartText;                     (* safer to leave in text mode *)
  310. END; (* InitVDU *)
  311.